home *** CD-ROM | disk | FTP | other *** search
/ The Utilities Experience / The Utilities Experience - Volume 1.iso / software / graphics / n-z / playkiss / src / makemap.e < prev    next >
Text File  |  1995-12-21  |  4KB  |  177 lines
  1.  
  2.  
  3. MODULE 'dos/dos','dos/dosextens','dos/dosasl','exec/tasks'
  4.  
  5. DEF rdarg
  6. DEF argarray[11]:LIST
  7. DEF source[250]:STRING
  8. DEF dest[250]:STRING
  9. DEF palette[250]:STRING
  10. DEF dummy[250]:STRING
  11. DEF array[250]:LIST
  12. DEF fh1,fh2,fh3,res,i,t,offset,names:PTR TO LONG
  13. DEF re[18]:LIST,gr[18]:LIST,bl[18]:LIST,lc=0,toomany=0
  14. DEF red,grn,blu
  15. DEF buffer
  16. DEF x,y,w,h,nw
  17. DEF long
  18. DEF r1,g1,b1,r2,g2,b2
  19. DEF res1,res2
  20. DEF apath=NIL:PTR TO anchorpath
  21.  
  22. RAISE "^C" IF CtrlC ()=TRUE
  23.  
  24. PROC ibmconv(a)
  25.     DEF hi,lo,ret
  26.     hi:=a AND $FF00
  27.     lo:=a AND $00FF
  28.     ret:=Shl(lo,8) OR Shr(hi,8)
  29. ENDPROC ret
  30.  
  31. PROC readstring(fh,buf)
  32.     DEF ret=0,bp=0
  33.  
  34.     PutLong(buf,0)
  35.     PutLong(buf+4,0)
  36.     Read(fh,buf+bp,1);bp:=bp+1
  37.     WHILE (iswhitespace(Char(buf+bp-1))=0)
  38.         Read(fh,buf+bp,1);bp:=bp+1
  39.         CtrlC()
  40.     ENDWHILE
  41.     PutChar(buf+bp-1,0)
  42.     StrToLong(buf,{ret})
  43. ENDPROC ret
  44.  
  45. PROC iswhitespace(a)
  46.     IF a=10 THEN RETURN TRUE
  47.     IF a=9 THEN RETURN TRUE
  48.     IF a=13 THEN RETURN TRUE
  49.     IF a=32 THEN RETURN TRUE
  50.     IF a="," THEN RETURN TRUE
  51. ENDPROC FALSE
  52.  
  53. PROC dofindcolors(str)
  54.     DEF fileinfo=NIL:PTR TO fileinfoblock
  55.     DEF    achain=NIL:PTR TO achain
  56.     DEF err=0,pathlen,filestart,first=0,chance=1
  57.     DEF    newdate=NIL:PTR TO datestamp
  58.  
  59.     apath:=New(SIZEOF anchorpath)
  60.  
  61.     WHILE err=NIL
  62.         IF first=FALSE
  63.             err:=MatchFirst(str,apath)
  64.             first:=TRUE
  65.         ELSE
  66.             err:=MatchNext(apath)
  67.         ENDIF
  68.         IF err=NIL
  69.             achain:=apath.last
  70.             IF (achain)
  71.                 fileinfo:=achain.info
  72.                 IF (fileinfo)
  73.                     IF (fileinfo.direntrytype)<0
  74.                         doscan(fileinfo.filename)
  75.                     ENDIF
  76.                 ENDIF
  77.             ENDIF
  78.         ENDIF
  79.     ENDWHILE
  80.     IF apath THEN MatchEnd(apath)
  81.     IF apath THEN Dispose(apath);apath:=NIL
  82. ENDPROC
  83.  
  84. PROC doscan(file)
  85.     WriteF('\nScanning file "\s"...',file)
  86.     IF (fh1:=Open(file,MODE_OLDFILE))
  87.         Read(fh1,buffer,3)
  88.         IF Int(buffer)="P6"
  89.             w:=readstring(fh1,buffer)
  90.             h:=readstring(fh1,buffer)
  91.             i:=readstring(fh1,buffer)
  92.             WriteF('size: (\d x \d x \d)',w,h,i)
  93.             FOR y:=0 TO h-1
  94.                 res:=Read(fh1,buffer,w*3)
  95.                 IF res>=0
  96.                     FOR x:=0 TO w-1
  97.                         r1:=((Char(buffer+(x*3))) AND $F0)
  98.                         g1:=((Char(buffer+(x*3)+1)) AND $F0)
  99.                         b1:=((Char(buffer+(x*3)+2)) AND $F0)
  100.                         IF exi(r1,g1,b1)=0
  101.                             re[lc]:=(r1 AND $F0)
  102.                             gr[lc]:=(g1 AND $F0)
  103.                             bl[lc]:=(b1 AND $F0)
  104.                             IF lc<16
  105.                                 lc:=lc+1
  106. WriteF('\n($\h\h\h) ',r1,g1,b1)
  107.                             ELSE
  108.                                 toomany:=TRUE
  109.                             ENDIF
  110.                         ENDIF
  111.                     ENDFOR
  112.                 ENDIF
  113.             ENDFOR
  114.         ENDIF
  115.         Close(fh1);fh1:=0
  116.     ENDIF
  117. ENDPROC
  118.  
  119. PROC exi(r,g,b)
  120.     DEF tt
  121.     FOR tt:=0 TO lc
  122.         IF ((re[tt]=r) AND (gr[tt]=g) AND (bl[tt]=b)) THEN RETURN TRUE
  123.     ENDFOR
  124. ENDPROC FALSE
  125.  
  126. PROC main() HANDLE
  127.     buffer:=New(10000)
  128.     argarray[0]:=0
  129.     argarray[1]:=0
  130.     rdarg:=ReadArgs('FROM/A/M,TO/A',argarray,0)
  131.  
  132.     IF argarray[0]=NIL
  133.         Raise("HELP")
  134.     ENDIF
  135.     IF argarray[1]<>NIL
  136.         StrCopy(dest,argarray[1],ALL)
  137.     ELSE
  138.         Raise("HELP")
  139.     ENDIF
  140.     IF (rdarg<>0)
  141.         names:=argarray[0]
  142.         WHILE (names[0])
  143. WriteF('\n\nSearching for "\s"',names[0])
  144.             dofindcolors(names[]++)
  145.         ENDWHILE
  146.     ENDIF
  147.  
  148.     IF (fh2:=Open(dest,MODE_NEWFILE))
  149.  
  150.         PutLong(buffer,$50360A31)       -> P6 nl 1
  151.         PutLong(buffer+4,$3620310A)     -> 6 space 1 nl
  152.         PutLong(buffer+8,$3235350A)     -> 255 nl
  153.         res:=Write(fh2,buffer,12)
  154.         FOR i:=0 TO 15
  155.             PutChar(buffer,re[i])
  156.             PutChar(buffer+1,gr[i])
  157.             PutChar(buffer+2,bl[i])
  158.             res:=Write(fh2,buffer,3)
  159.         ENDFOR
  160.         WriteF('\n\nSaved \d colors.',lc)
  161.     ENDIF
  162. EXCEPT DO
  163.     WriteF('\n\n')
  164.     IF toomany THEN WriteF('More than 16 colors were found.\n')
  165.     IF apath THEN MatchEnd(apath)
  166.     IF apath THEN Dispose(apath);apath:=NIL
  167.     IF fh1 THEN Close(fh1)
  168.     IF fh2 THEN Close(fh2)
  169.     IF buffer THEN Dispose(buffer)
  170.     IF exception="HELP" THEN WriteF('Usage: ppmtocel FROM\\A,TO\n\n')
  171.     IF exception="DOS" THEN WriteF('An error occured.\n\n')
  172.     IF exception="PAL" THEN WriteF('Colors do not match.  Use "ppmquant -map".\n\n')
  173.     IF exception="P6P6" THEN WriteF('Map file contains more than 16 colors.\n\n')
  174.     IF exception="NOP6" THEN WriteF('Map file is invalid.\n\n')
  175.     IF exception="NOP5" THEN WriteF('Source file is invalid.\n\n')
  176. ENDPROC
  177.